home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d20
/
wnode21.arc
/
WNODE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-01-15
|
22KB
|
680 lines
Unit WNode;
{$O+;$R-;F+}
{****************************************************************************}
{ Window nodelist handler for editors,mailers and mail processors }
{ Copyright 1991 by Silvan Calarco (2:334/100.2@fidonet.org) }
{****************************************************************************}
{****************************************************************************}
{ This unit may be used in your programs and is distributed to favour the }
{ diffusion of an unique nodelist format. The nodelist compiler program is }
{ called WNODE.EXE and is availaible either in the packed that contains }
{ this unit and in SDS network. }
{ The structures of W-Nodelist are in file WNSTRUCT.DOC. }
{ }
{ HOW TO USE THIS UNIT ------------------------------------------------------}
{ }
{ First thing to do is initializing nodelist files by calling: }
{ }
{ Function InitNodeList(DirName:String):Boolean; }
{ }
{ Where DirName is the full path of the directory containing *.WNL files. }
{ This function returns false if one of nodelist files is missing. }
{ }
{ Using W-Nodelist two sort of shearches can be made: }
{ 1) By Sysop's name with FindFirstSysop and FindNextSysop }
{ 2) By Node number with FindFirstNode and FindNextNode }
{ }
{ Before performing any sort of search, you have to declare a variable }
{ of type FindNodeRec. The filosophy of this method is very similar to }
{ the one used by TP's FindFirst/FindNext procedures, so FindNodeRec has }
{ the same purpose of SearchRec in unit DOS of TP. }
{ Inquire results will be returned in FindNodeRec.BBSRecord, a record }
{ which contains these informations: }
{ }
{ BBSRecord=Record }
{ NodeType:Byte; }
{ Zone,Net,Node,Point:Integer; }
{ BBSName:String[30]; }
{ SysopName:String[30]; }
{ Location:String[30]; }
{ Phone:String[18]; }
{ BaudRate:Word; }
{ Flags:String[30]; }
{ end; }
{ }
{ NODETYPE contains one of the following values: }
{ }
{ ZC=1; REGION=2; HOST=4; HUB=8; PVT=16; INHOLD=32; DOWN=64; BOSS=128 }
{ }
{ Other fields contents are the image of what appears in nodelist. }
{ }
{----------------------------------------------------------------------------}
{ }
{ 1) FindFirstSysop/FindNextSysop }
{ }
{ To look for one or more entries knowing sysop's name call first time: }
{ }
{ Procedure FindFirstSysop(SubStr:String;Var Find:FindNodeRec); }
{ }
{ Where SubStr is the case unsensitive match string for sysop's name. }
{ Note that a name like "John Mc Gregor" is converted in "GREGOR MC JOHN" }
{ for search. This means that match string "MC GREGOR" wouldn't return }
{ the desired entry. }
{ }
{ To continue search use: }
{ }
{ Procedure FindNextSysop(Var Find:FindNodeRec); }
{ }
{ If Find.BBSRecord.SysopName='' it means that there are no more entries. }
{ }
{----------------------------------------------------------------------------}
{ }
{ 2) FindFirstNode/FindNextNode }
{ }
{ To look for one or more entries knowing address call first time: }
{ }
{ Procedure FindFirstNode(Zone,Net,Node,Point:Integer;Var Find:FindNodeRec); }
{ }
{ Where Zone,Net,Node,Point contain the address of the node to look for. }
{ If you want to look for more than one entry, you can assign one of address }
{ fields the value of "ALL" constant. E.g.: }
{ }
{ Zone:=ALL looks for every node in database }
{ Zone:=2; Net:=334; Node:=ALL looks for every node in zone 2, net 334 }
{ }
{ To continue search use: }
{ }
{ Procedure FindNextSysop(Var Find:FindNodeRec); }
{ }
{ If Find.BBSRecord.SysopName='' it means that there are no more entries. }
{ }
{ You you don't want many files to be open at same time, you can call: }
{ }
{ Procedure CloseNodeListFiles; }
{ }
{ after any search. FindFirstNode/FindFirstSysop will open them again if }
{ they are closed. }
{ }
{****************************************************************************}
Interface
Const
{ List of kinds of entryes specified in BBSRecord.NodeType }
ZC=1;
REGION=2;
HOST=4;
HUB=8;
PVT=16;
INHOLD=32;
DOWN=64;
BOSS=128;
ALL=-1; { Used to select global nodes with FindFirstNode }
Type
BBSRec=Record { Record containing nodelist informations }
NodeType:Byte;
Zone,Net,Node,Point:Integer;
BBSName:String[30];
SysopName:String[30];
Location:String[30];
Phone:String[18];
BaudRate:Word;
Flags:String[30];
end;
NodeLocRec=Record { Record of NODELOC.WNL }
NodeType:Byte;
Zone,Net,Node,Point:Integer;
FileNum:Byte;
FilePos:Longint;
end;
SysopRec=Record { Record of SYSLIST.WNL }
Name:String[20];
BBSRecord:Longint;
end;
NodeRec=Record { Record of NODEIDX.WNL }
NodeType:Byte;
Number:Integer;
BBSRecord:Longint;
Match:Array[1..4] of Char;
SysopRecord:Longint;
end;
FindNodeRec=Record { Used by FindFirstNode/FindFirstSysop }
BBSRecord:BBSRec;
SZone,SNet,SNode,SPoint:Integer;
SysStr:String[30];
FPos,FPos1:Longint;
end;
Var
NodeLocFile:File of NodeLocRec;
SysopListFile:File of SysopRec;
NodeIdxFile:File of NodeRec;
Nodelist1,NodeList2:File;
NodeTime:Longint;
Function InitNodeList(DirName:String):Boolean; { True=Ok }
Procedure CloseNodeListFiles;
Procedure FindFirstSysop(SubStr:String;Var Find:FindNodeRec);
Procedure FindNextSysop(Var Find:FindNodeRec);
Procedure FindFirstNode(Zone,Net,Node,Point:Integer;Var Find:FindNodeRec);
Procedure FindNextNode(Var Find:FindNodeRec);
Procedure Split_Address(Address:String;Var Zone,Net,Node,Point:Integer);
{ Splits a string-typed address into four }
{ numbers indicating Zone,Net,Node and Point }
Function Word_Upcase(Frase:String):String;
{ Converts a string into its upper-case }
{ correspondent }
Implementation
Uses
Dos;
Function FileExists(Nome_Del_File:String):Boolean;
Var
TestFile:File;
Begin
Assign(TestFile,Nome_Del_File);
{$I-}
Reset(TestFile);
{$I+}
If IOResult=0 then
Begin
FileExists:=True;
Close(TestFile);
end
else
FileExists:=False;
end;
Function Val2(St:String):Longint;
Var
Res:Longint;
Err:Integer;
Begin
Val(St,Res,Err);
Val2:=Res;
end;
Function Word_Upcase(Frase:String):String;
Var
Kunta:Integer;
Begin
For Kunta:=1 to Length(Frase) do
Frase[Kunta]:=UpCase(Frase[Kunta]);
Word_UpCase:=Frase;
end;
Function CmpSort(Stringa1,Stringa2:String):Byte;
Var
Pos:Byte;
Exit:Byte;
Begin
Pos:=1;
Exit:=0;
While (Pos<=Length(Stringa1)) and (Pos<=Length(Stringa2))
and (Exit=0) do
Begin
If Stringa1[Pos]<Stringa2[Pos] then
Exit:=1
else
If Stringa1[Pos]>Stringa2[Pos] then
Exit:=2;
Inc(Pos);
end;
If Exit=0 then
Begin
If Length(Stringa1)<Length(Stringa2) then
Exit:=1
else
If Length(Stringa1)>Length(Stringa2) then
Exit:=2
else
Exit:=3;
end;
CmpSort:=Exit;
end;
Function Convert_Name(FromStr:String):String; { Converts 'Silvan Calarco' into }
{ 'CALARCO SILVAN' }
Var
ResStr:String;
Cont:Byte;
Begin
ResStr:='';
FromStr:=Word_UpCase(FromStr)+' ';
While Length(FromStr)>0 do
Begin
Insert(Copy(FromStr,1,Pos(' ',FromStr)),ResStr,1);
Delete(FromStr,1,Pos(' ',FromStr));
end;
ResStr[0]:=Chr(Length(ResStr)-1);
For Cont:=2 to Length(ResStr) do
If (ResStr[Cont] in ['A'..'Z']) and (ResStr[Cont-1]<>#32) then
ResStr[Cont]:=Chr(Ord(ResStr[Cont])+32);
Convert_Name:=ResStr;
end;
Function ReadVar(Var Linea:String):String;
Var
C:Byte;
Begin
C:=1;
While (Linea[C]<>',') and (C<=Length(Linea)) do
Begin
If Linea[C]='_' then
Linea[C]:=' ';
Inc(C);
end;
If Pos(',',Linea)=0 then
Begin
ReadVar:=Copy(Linea,1,Pos(#13,Linea)-1);
Linea:='';
end
else
Begin
ReadVar:=Copy(Linea,1,Pos(',',Linea)-1);
Delete(Linea,1,Pos(',',Linea));
end;
end;
Procedure Split_Address(Address:String;Var Zone,Net,Node,Point:Integer);
Var
MomStr:String[5];
Begin
Address:=Word_UpCase(Address);
If Copy(Address,1,3)='ALL' then
Begin
Zone:=-1;Net:=-1;Node:=-1;Point:=-1;
end
else
Begin
Address:=Address+' ';
Zone:=Val2(Copy(Address,1,Pos(':',Address)-1));
If Zone=0 then
Zone:=2;
Delete(Address,1,Pos(':',Address));
If copy(Address,1,3)='ALL' then
Begin
Net:=-1;
Node:=-1;
Point:=-1;
end
else
Begin
If Pos('/',Address)<>0 then
Net:=Val2(Copy(Address,1,Pos('/',Address)-1));
Delete(Address,1,Pos('/',Address));
If Pos('.',Address)<>0 then
Begin
Node:=Val2(Copy(Address,1,Pos('.',Address)-1));
If Address[1]='.' then
Begin
Net:=0;
Node:=0;
end;
Delete(Address,1,Pos('.',Address));
Point:=Val2(Copy(Address,1,Pos(' ',Address)-1));
end
else
Begin
MomStr:=Copy(Address,1,Pos(' ',Address)-1);
If MomStr='ALL' then
Node:=-1
else
Node:=Val2(MomStr);
Point:=0;
end
end
end
end;
Function TrovaTipo(Sub:String):Byte;
Begin
If Sub='' then
TrovaTipo:=0
else
If Sub='ZONE' then
TrovaTipo:=ZC
else
If Sub='REGION' then
TrovaTipo:=Region
else
If Sub='HOST' then
TrovaTipo:=Host
else
If Sub='HUB' then
TrovaTipo:=Hub
else
If Sub='PVT' then
TrovaTipo:=Pvt
else
If Sub='HOLD' then
TrovaTipo:=InHold
else
If Sub='DOWN' then
TrovaTipo:=Down
else
If Sub='BOSS' then
TrovaTipo:=Boss;
end;
Procedure RicavaRecord(Var St:String;Var BBSRecord:BBSRec;CurrZone,CurrNet,CurrNode:Integer);
Var
Sub:String;
Err:Integer;
Begin
FillChar(BBSRecord,SizeOf(BBSRecord),#0);
With BBSRecord do
Begin
Sub:=Word_UpCase(ReadVar(St));
NodeType:=TrovaTipo(Sub);
Sub:=ReadVar(St);
If NodeType=ZC then
Begin
CurrZone:=Val2(Sub);
CurrNet:=0;
CurrNode:=-1;
end
else
If NodeType in [Region,Host] then
Begin
CurrNet:=Val2(Sub);
CurrNode:=-1;
end
else
If NodeType=Boss then
Begin
Delete(Sub,Pos(#13,Sub),1);
Split_Address(Sub,CurrZone,CurrNet,CurrNode,Err)
end
else
Begin
If CurrNode=-1 then
Node:=Val2(Sub)
else
Begin
Node:=CurrNode;
Point:=Val2(Sub);
end;
end;
Zone:=CurrZone;
Net:=CurrNet;
If NodeType<>Boss then
Begin
BBSName:=ReadVar(St);
Location:=ReadVar(St);
SysopName:=ReadVar(St);
Phone:=ReadVar(St);
BaudRate:=Val2(ReadVar(St));
Flags:=Copy(St,1,Pos(#13,St)-1);
end
else
Node:=CurrNode;
end;
end;
Procedure FindRecord(NodoRec:NodeLocRec;Var ToRec:BBSRec);
Var
Letti:Word;
Linea:String;
Begin
Case NodoRec.FileNum of
1:If FileRec(Nodelist1).Mode=FMClosed then
Reset(Nodelist1,1);
2:If FileRec(Nodelist2).Mode=FMClosed then
Reset(Nodelist2,1);
end;
Case NodoRec.FileNum of
1:Begin
Seek(Nodelist1,NodoRec.FilePos);
BlockRead(Nodelist1,Linea[1],255,Letti);
Linea[0]:=Chr(Letti);
end;
2:Begin
Seek(Nodelist2,NodoRec.FilePos);
BlockRead(Nodelist2,Linea[1],255,Letti);
Linea[0]:=Chr(Letti);
end;
end;
RicavaRecord(Linea,ToRec,0,0,-1);
ToRec.Zone:=NodoRec.Zone;
ToRec.Net:=NodoRec.Net;
ToRec.Node:=NodoRec.Node;
ToRec.Point:=NodoRec.Point;
end;
Function ConfrNode(Zona1,Net1,Nodo1,Point1,Zona2,Net2,Nodo2,Point2:Integer):Boolean;
Begin
If (Zona1=ALL) or
((Zona1=Zona2) and (Net1=ALL)) or
((Zona1=Zona2) and (Net1=Net2) and (Nodo1=ALL)) or
((Zona1=Zona2) and (Net1=Net2) and (Nodo1=Nodo2) and (Point1=ALL)) or
((Zona1=Zona2) and (Net1=Net2) and (Nodo1=Nodo2) and (Point1=Point2)) then
ConfrNode:=True
else
ConfrNode:=False;
end;
Procedure FindNextNodeIndex(Var Find:FindNodeRec);
Const
ActZone:Integer=-1;
ActNet:Integer=-1;
Var
Nodelist:NodeRec;
ActPos:Longint;
Esci:Boolean;
Begin
Seek(NodeIdxFile,Find.FPos1);
Repeat
Read(NodeIdxFile,Nodelist);
ActPos:=Nodelist.BBSRecord;
If Nodelist.NodeType=ZC then
Begin
ActZone:=Nodelist.Number;
ActNet:=0;
end
else
If Nodelist.NodeType in [Region,Host,Boss] then
ActNet:=Nodelist.Number;
Esci:=(ConfrNode(Find.SZone,Find.SNet,0,0,ActZone,ActNet,0,0));
Until Esci or Eof(NodeIdxFile);
Find.FPos1:=FilePos(NodeIdxFile);
If not(Esci) then
ActPos:=-1;
Find.FPos:=ActPos;
end;
Procedure FindNextSysop(Var Find:FindNodeRec);
Var
SysopList:SysopRec;
NodeLoc:NodeLocRec;
Begin
Seek(SysopListFile,Find.FPos);
SysopList.Name:='';
While not(Eof(SysopListFile)) and
(CmpSort(Find.SysStr,SysopList.Name) in [2,3]) do
Begin
Read(SysopListFile,SysopList);
If (Pos(Find.SysStr,SysopList.Name)=1) then
Begin
Seek(NodeLocFile,SysopList.BBSRecord);
Read(NodeLocFile,NodeLoc);
FindRecord(NodeLoc,Find.BBSRecord);
Find.FPos:=FilePos(SysopListFile);
Exit;
end
end;
Find.BBSRecord.SysopName:='';
end;
Procedure FindNextNode(Var Find:FindNodeRec);
Var
BBSList:NodeLocRec;
Begin
Seek(NodeLocFile,Find.FPos);
While not(Eof(NodeLocFile)) and (Find.FPos<>-1) do
Begin
Read(NodeLocFile,BBSList);
If ConfrNode(Find.SZone,Find.SNet,Find.SNode,Find.SPoint,
BBSList.Zone,BBSList.Net,BBSList.Node,BBSList.Point) and
(BBSList.NodeType<>Boss) then
Begin
FindRecord(BBSList,Find.BBSRecord);
Find.FPos:=FilePos(NodeLocFile);
Exit;
end;
If not(ConfrNode(Find.SZone,Find.SNet,0,0,BBSList.Zone,BBSList.Net,0,0)) then
Begin
FindNextNodeIndex(Find);
If Find.FPos<>-1 then
Seek(NodeLocFile,Find.Fpos);
end;
end;
Find.BBSRecord.SysopName:='';
end;
Procedure FindFirstSysop(SubStr:String;Var Find:FindNodeRec);
Var
NodeIdx:NodeRec;
ActRec:Longint;
ExtrStr:String[4];
Begin
Find.SysStr:=Word_UpCase(Convert_Name(SubStr));
ExtrStr:=Copy(Find.SysStr,1,4);
Find.BBSRecord.SysopName:='';
Find.FPos:=0;
If FileRec(NodeLocFile).Mode=FMClosed then
Reset(NodeLocFile);
If FileRec(SysopListFile).Mode=FMClosed then
Reset(SysopListFile);
If FileRec(NodeIdxFile).Mode=FMClosed then
Reset(NodeIdxFile);
Seek(NodeIdxFile,0);
NodeIdx.SysopRecord:=0;
Repeat
ActRec:=NodeIdx.SysopRecord;
Read(NodeIdxFile,NodeIdx);
Until (CmpSort(ExtrStr,NodeIdx.Match) in [1,3]) or
Eof(NodeIdxFile);
Find.FPos:=ActRec;
FindNextSysop(Find);
end;
Procedure FindFirstNode(Zone,Net,Node,Point:Integer;Var Find:FindNodeRec);
Begin
Find.SZone:=Zone;
Find.SNet:=Net;
Find.SNode:=Node;
Find.SPoint:=Point;
Find.BBSRecord.SysopName:='';
If FileRec(NodeLocFile).Mode=FMClosed then
Reset(NodeLocFile);
If FileRec(SysopListFile).Mode=FMClosed then
Reset(SysopListFile);
If FileRec(NodeIdxFile).Mode=FMClosed then
Reset(NodeIdxFile);
Find.FPos1:=0;
FindNextNodeIndex(Find);
FindNextNode(Find);
end;
Function Trova_File_Recente(Dir:String;Var Check:Boolean):String;
Var
S:SearchRec;
ActTime:Longint;
ActFile:String[12];
Num,Err:Word;
Begin
ActTime:=0;
ActFile:='';
S.Name:='';
FindFirst(Dir,Archive,S);
While S.Name<>'' do
Begin
Err:=0;
If Check then
Val(Copy(S.Name,Pos('.',S.Name)+1,3),Num,Err);
If (S.Time>ActTime) and (Err=0) then
Begin
ActTime:=S.Time;
ActFile:=S.Name;
end;
S.Name:='';
FindNext(S);
end;
If (ActTime<NodeTime) and (NodeTime*ActTime<>0) then
Check:=True
else
Check:=False;
If ActFile='' then
Dir:=''
else
While (Dir[Length(Dir)]<>'\') and (Length(Dir)>0) do
Delete(Dir,Length(Dir),1);
Trova_File_Recente:=Dir+ActFile;
end;
Function InitNodeList(DirName:String):Boolean;
Var
C:Boolean;
S:SearchRec;
Begin
If (DirName[Length(DirName)]<>'\') and (Length(DirName)>0) then
DirName:=DirName+'\';
DirName:=FExpand(DirName);
Assign(NodeLocFile,DirName+'nodeloc.wnl');
Assign(SysopListFile,DirName+'syslist.wnl');
Assign(NodeIdxFile,DirName+'nodeidx.wnl');
C:=True;
Assign(Nodelist1,Trova_File_Recente(DirName+'NODELIST.*',C));
Assign(Nodelist2,DirName+'ALTNODE.WNL');
InitNodeList:=FileExists(DirName+'syslist.wnl') and
FileExists(DirName+'nodeidx.wnl') and
FileExists(DirName+'nodeloc.wnl');
S.Name:='';
FindFirst(DirName+'NODELOC.WNL',Archive,S);
If S.Name<>'' then
NodeTime:=S.Time
else
NodeTime:=0;
end;
Procedure CloseNodeListFiles;
Begin
If FileRec(NodeLocFile).Mode=FMInOut then
Close(NodeLocFile);
If FileRec(SysopListFile).Mode=FMInOut then
Close(SysopListFile);
If FileRec(NodeIdxFile).Mode=FMInOut then
Close(NodeIdxFile);
If FileRec(NodeList1).Mode=FMInOut then
Close(NodeList1);
If FileRec(NodeList2).Mode=FMInOut then
Close(NodeList2);
end;
Begin
end.